home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / VTOOLS / VTWIN.PAS < prev   
Pascal/Delphi Source File  |  1995-03-13  |  16KB  |  425 lines
  1. UNIT VTWIN;
  2.  INTERFACE
  3. Uses VTFAST;
  4.  Const   MaxWindows  = 20;           { Maximal used Windows }
  5.          MaxScreens  = 5;            { Maximal screens to save }
  6.          UserScreens :  Byte = 5;    { User defined screens
  7.                                        Get Memory for UserScreens ->
  8.                                        UserScreens * VideoPage Bytes }
  9.          UserWindows : Byte = 10;
  10.          WinStackPt : Byte = 0;
  11.          StartMemorySize : LongInt = 0;
  12.  
  13.  AttachedWindows : set of byte = [];
  14.  Type WinHook = Procedure;
  15.  Type WinStack = Array[1..MaxWindows] of Byte; { Here save a window ID No. }
  16.  Type ScreenDescription = RECORD
  17.                            ScreenBuffer : Pointer;
  18.                            CursorX,
  19.                            CursorY,
  20.                            CursorT,
  21.                            CursorB : Byte;
  22.                             Saved,
  23.                          Allocated : Boolean;
  24.                           END;
  25.  Type WindowDescription = RECORD                    {This is description }
  26.                               WinX,WinY,
  27.                             WinX1,WinY1,
  28.                                     BoxT : Byte;  { of any of a window }
  29.                                   Explode,
  30.                                 ShadowFlag : Boolean;
  31.                                      Title : String[78];
  32.                              TitleF,TitleB : Byte;
  33.                                  BoxF,BoxB : Byte;
  34.                              InnerF,InnerB : Byte;
  35.                                SavedScreen : Pointer;
  36.                            CalledProcedure : WinHook;   { When user display  }
  37.                                  Attached,              { window this proce- }
  38.                                  Displayed : Boolean;   { dure is calling.   }
  39.                           END;                          { WARNING!
  40.                                                         PROCEDURE MUST BE IN
  41.                                                         A FAR MODEL          }
  42.  
  43.  Type Direction = (Left,Right,Up,Down);
  44.  
  45.  Var W_Array : Array[1..MaxWindows] of ^WindowDescription;
  46.      S_Array : Array[1..MaxScreens] Of ^ScreenDescription;
  47.        Stack : WinStack;
  48. Procedure WinInit; { Initialize unit with startup parameters. Not recomended
  49.                                 to use it with defined windows }
  50. Procedure RemoveAllMemory;                   { Good for a end }
  51.                                              { of program     }
  52. Procedure SaveScreen(Num : Byte);
  53. Procedure RestoreScreen(Num : Byte);
  54. Procedure AllocateScreens;                   { To use a save&restore}
  55. Procedure DisposeScreens;                    { screen must Allocate it first}
  56.  
  57. Procedure GetFromScreen(X,Y,X1,Y1 : Word; Dest : Pointer); {Grabs & Puts }
  58. Procedure PutToScreen(X,Y,X1,Y1 : Word; Source : Pointer); {blocks from screen}
  59.                               {Source must be a reserved before memory block
  60.                                with length ((X1-X) * 2) + ((Y1-Y)*160) Bytes }
  61. Procedure CopyScreenBlock(X,Y,X1,Y1,NewX,NewY : Word); { Copies block from
  62.                                               Screen to another coordinates
  63.                               !!! WARNING: MUST !!! NewX < X AND  NewX > X1 }
  64. Procedure Scroll(X,Y,X1,Y1,Attr : Byte;Ch : Char;Dir : Direction);
  65. Procedure DisplayShadow(X,Y,X1,Y1 : Byte);
  66. Procedure DefineWindow(Winnum,X,Y,X1,Y1,Box : Byte;Expl,Shadow : Boolean;Tit : String);
  67. Procedure SetWindowColors(WinNum,BoxFor,BoxBack,TitF,TitB,InF,InB : Byte);
  68. Procedure AssignWinProc (WinNum : Byte;PassedProc : WinHook);
  69.  
  70. Procedure AllocateWindows; {Reserve memory for UserWindows. !MUST BE USED }
  71. Procedure DisposeWindows;  {Reliease memory}      {FOR USING DISPLAY WINDOW}
  72. Procedure DisplayWindow(WinNum : byte);
  73. Procedure RemoveWindow;      {Remove the last displayed window}
  74.  
  75. Procedure TempMessage(X,Y,TxtF,TxtB : Byte;Txt : String);
  76. Procedure TempMessageChar(X,Y,TxtF,TxtB : Byte;Txt : String;Var Ch : Char);
  77.  
  78. Procedure TempMessageBox(X,Y,BoxF,BoxB,BoxT,TxtF,TxtB : Byte;Txt : String);
  79. Procedure TempMessageBoxChar(X,Y,BoxF,BoxB,BoxT,TxtF,TxtB : Byte;Txt : String;Var Ch : Char);
  80.  
  81. {
  82. Procedure ExplodeTempMessageBox(X,Y,BoxF,BoxB,BoxT,TxtF,TxtB : Byte;Txt : String);
  83. Procedure ExplodeTempMessageBoxChar(X,Y,BoxF,BoxB,BoxT,TxtF,TxtB : Byte;
  84.                                      Txt : String;Var Ch : Char);
  85. }
  86.  
  87. IMPLEMENTATION
  88. Const   SavedMemoryFlag : Boolean = False;
  89.  
  90. Var            Tmp : Byte;
  91.     StartMemoPoint : Pointer;
  92.         CalledHook : Pointer;
  93. {$L VTWIN}
  94. {$F+}
  95.  Procedure GetScreen(Dest : Pointer); EXTERNAL;
  96.  Procedure PutScreen(Source : Pointer); EXTERNAL;
  97.  Procedure GetFromScreen(X,Y,X1,Y1 : Word; Dest : Pointer); EXTERNAL;
  98.  Procedure PutToScreen(X,Y,X1,Y1 : Word; Source : Pointer); EXTERNAL;
  99.  Procedure CopyScreenBlock(X,Y,X1,Y1,NewX,NewY : Word); EXTERNAL;
  100. {$F-}
  101. Procedure VTWinERROR(Status : Byte);
  102. Var Msg : String[70];
  103. Begin
  104.  Write('VTWIN Error #',Status);
  105.  Case Status Of
  106.        1 : Msg :='.  Screen/Window must be alocated first!';
  107.        2 : Msg :='.  Unable to create more Screens/Windows. Request is more than maximal.';
  108.        3 : Msg :='.  Unable to allocate memory for operation!';
  109.        4 : Msg :='.  Window allready displayed!.';
  110.        5 : Msg :='.  Too many open windows!';
  111.        6 : Msg :='.  Screen not saved! Can`t activate.';
  112.  End;
  113.   WriteLn(Msg);
  114.  RemoveAllMemory;
  115.  Halt;
  116. End;
  117. Procedure RemoveAllMemory;
  118. Begin
  119.  If SavedMemoryFlag Then Dispose(StartMemoPoint);
  120. End;
  121. Procedure AllocateScreens;
  122. Begin
  123.  For Tmp := 1 To UserScreens Do Begin
  124.                                  If Tmp > MaxScreens Then VTWinError(2);
  125.                                  If MaxAvail < (SizeOf(ScreenDescription)+VPageL) Then VTWinError(3);
  126.                                  GetMem(S_Array[Tmp],SizeOf(ScreenDescription));
  127.                                  GetMem(S_Array[Tmp]^.ScreenBuffer,VPageL);
  128.                                  S_Array[Tmp]^.Allocated := true;
  129.                                 End;
  130. End;
  131. Procedure DisposeScreens;
  132. Begin
  133.  For Tmp := 1 To UserScreens Do If S_Array[Tmp]^.Allocated Then
  134.                                   Begin
  135.                                     S_Array[Tmp]^.Allocated := False;
  136.                                     FreeMem(S_Array[Tmp]^.ScreenBuffer,VPageL);
  137.                                     FreeMem(S_Array[Tmp],SizeOf(ScreenDescription));
  138.                                   End;
  139. End;
  140. {===========* Same like VTKEY.GETKEY *================}
  141.  procedure Getkey(var AscCode,PosCode : Byte); assembler;
  142.    asm
  143.    PUSH DS   { Save the DS & ES }
  144.    PUSH ES
  145.    MOV AH,0h { Attach the 0 function | Get next key or wait for key }
  146.    INT 16h
  147.    LES DI,AscCode { Load the ASCII code }
  148.     STOSB
  149.    MOV AL,AH      { Load Position code }
  150.    LES DI,PosCode
  151.     STOSB
  152.    POP ES         { Restore old ES & DS }
  153.    POP DS
  154.   end;
  155.  
  156. Procedure SaveScreen(Num : Byte);
  157. Begin
  158.  If Not S_Array[Num]^.Allocated Then VTWinError(1);
  159.  With S_Array[Num]^ Do Begin
  160.                         GetXY(CursorX,CursorY);
  161.                         GetCursor(CursorT,CursorB);
  162.                         GetScreen(ScreenBuffer);
  163.                         Saved := True;
  164.                        End;
  165. End;
  166. Procedure RestoreScreen(Num : Byte);
  167. Begin
  168.  If Not S_Array[Num]^.Allocated Then VTWinError(1);
  169.  If Not S_Array[Num]^.Saved Then VTWinError(6);
  170.  With S_Array[Num]^ Do Begin
  171.                         XY(CursorX,CursorY);
  172.                         SetCursor(CursorT,CursorB);
  173.                         PutScreen(ScreenBuffer);
  174.                        End;
  175. End;
  176. Procedure Scroll(X,Y,X1,Y1,Attr : Byte;Ch : Char;Dir : Direction);
  177. Var BlockSize : Word;
  178.     Pt : Pointer;
  179. Begin
  180.  Case Dir of
  181.       Up    : Begin
  182.                 ScrollUp(X,Y,X1,Y1,1,Attr);
  183.                 PlainWrite(X,Y1,ReplicateChar(X1-X+1,ch));
  184.               End;
  185.       Down  : Begin
  186.                 ScrollDown(X,Y,X1,Y1,1,Attr);
  187.                 PlainWrite(X,Y,ReplicateChar(X1-X+1,ch));
  188.               End;
  189.       Left  :Begin
  190.               CopyScreenBlock(X+1,Y,X1,Y1,X,Y);
  191.               ColorWriteVert(X1,Y,Attr,0,ReplicateChar(Y1-Y+1,ch));
  192.              End;
  193.       Right :Begin
  194.               BlockSize := ((X1-X-1) shl 2) + ((Y1-Y)*160);
  195.               If MaxAvail < BlockSize Then VTWinError(3);
  196.               GetMem(pt,BlockSize);
  197.               GetFromScreen(X,Y,X1-1,Y1,pt);
  198.               PutToScreen(X+1,Y,X1,Y1,Pt);
  199.               FreeMem(pt,BlockSize);
  200.               ColorWriteVert(X,Y,Attr,0,ReplicateChar(Y1-Y+1,ch));
  201.              End;
  202.  End;
  203. End;
  204. Procedure PushWindow(WinNum : Byte);
  205. Begin
  206.  Inc(WinStackPt);
  207.  If WinStackPt > MaxWindows Then VTWinError(5);
  208.  Stack[WinStackPt] := WinNum;
  209.  
  210. End;
  211. Procedure PopWindow;
  212. Begin
  213.  If WinStackPt < 1 Then Exit;
  214.  Dec(WinStackPt);
  215. End;
  216.  Function PushedWindow : Byte;
  217.  Begin
  218.   If WinStackPt < 1 Then PushedWindow := 0;
  219.   PushedWindow := Stack[WinStackPt];
  220.  End;
  221. Procedure DisposeWindows;
  222. Begin
  223.  For Tmp := 1 TO MaxWindows Do FreeMem(W_Array[Tmp],Sizeof(WindowDescription));
  224. End;
  225. Procedure DefineWindow(WinNum,X,Y,X1,Y1,Box : Byte;Expl,Shadow : Boolean;Tit : String);
  226. Begin
  227.  With W_Array[WinNum]^ do Begin
  228.                            WinX := X;
  229.                            WinY := Y;
  230.                            WinX1 := X1;
  231.                            WinY1 := Y1;
  232.                            BoxT := Box;
  233.                            Explode := Expl;
  234.                            ShadowFlag := Shadow;
  235.                            If (WinX < 3) OR (WinY1 > 23) Then ShadowFlag := False;
  236.                            Title := Tit;
  237.                           End;
  238.  AttachedWindows := AttachedWindows + [WinNum];
  239. End;
  240. Procedure SetWindowColors(WinNum,BoxFor,BoxBack,TitF,TitB,InF,InB : Byte);
  241. Begin
  242.   With W_Array[WinNum]^ Do Begin
  243.                             BoxF := BoxFor;
  244.                             BoxB := BoxBack;
  245.                             TitleF := TitF;
  246.                             TitleB := TitB;
  247.                             InnerF := InF;
  248.                             InnerB := InB;
  249.                            End;
  250. End;
  251. Procedure AssignWinProc ( WinNum : Byte;PassedProc : WinHook);
  252. Begin
  253.  W_Array[WinNum]^.CalledProcedure := PassedProc;
  254. End;
  255. Procedure AllocateWindows;
  256. Var WinBlock : Word;
  257. Begin
  258.  If UserWindows > MaxWindows Then VTWinError(3);
  259.  For Tmp := 1 to UserWindows do IF Tmp in AttachedWindows Then
  260.  With W_Array[Tmp]^ Do
  261.     Begin
  262.      IF ShadowFlag Then WinBlock := ((WinX1-WinX+2) shl 1) + ((WinY1-WinY+1) * 160)
  263.      Else WinBlock := ((WinX1-WinX) shl 1) + ((WinY1-WinY) * 160);
  264.      If MaxAvail < WinBlock Then VTWinError(3);
  265.      GetMem(SavedScreen,WinBlock);
  266.      Attached := True;
  267.     End;
  268. End;
  269. Procedure DisplayShadow(X,Y,X1,Y1 : Byte);
  270. Var
  271.  Fore,Back : Word;
  272. Procedure SetShadow(Xp,Yp : Byte); { INTERNAL }
  273.  
  274. Begin
  275.  GetCharAttributes(Xp,Yp,Fore,Back);
  276.  If Fore > 8 Then Fore := Fore - 8
  277.  Else Fore := 8;
  278.  If Back > 8 Then Back := Back - 8
  279.  Else Back := 0;
  280.  SetCharAttr(Xp,Yp,Attrib(Fore,Back));
  281. End;
  282. Begin
  283.  For Tmp := X-2 To X1-2 Do Begin
  284.                             SetShadow(Tmp,Y1+1);
  285.                            End;
  286.  For Tmp := Y+1 To Y1 Do Begin
  287.                           SetShadow(X-1,Tmp);
  288.                           SetShadow(X-2,Tmp);
  289.                          End;
  290. End;
  291. Procedure DisplayWindow(WinNum : byte);
  292. Begin
  293.  With W_Array[WinNum]^ Do
  294.  Begin
  295.   If Not Attached Then VTWinError(1);
  296.   If Displayed Then VTWinError(4);
  297.   {============ HERE MUST DISABLE PREVIOUS WINDOW =============}
  298.   Displayed := True;
  299.   PushWindow(WinNum);
  300.   If ShadowFlag Then GetFromScreen(WinX-2,WinY,WinX1,WinY1+1,SavedScreen)
  301.   Else GetFromScreen(WinX,WinY,WinX1,WinY1,SavedScreen);
  302.   If Explode Then ExplodeBox(WinX,WinY,WinX1,WinY1,BoxF,BoxB,BoxT)
  303.   Else Begin
  304.         ClearText(WinX,WinY,WinX1,WinY1,BoxF,BoxB);
  305.         DrawBox(WinX,WinY,WinX1,WinY1,BoxT);
  306.        End;
  307.   ClearText(WinX+1,WinY+1,WinX1-1,WinY1-1,InnerF,InnerB);
  308.   ColorWriteBetween(WinX,WinX1,WinY,TitleF,TitleB,Title);
  309.   If ShadowFlag Then DisplayShadow(WinX,WinY,WinX1,WinY1); {++ HERE PUSH SHADOW ++}
  310.   If Addr(CalledProcedure) <> Nil Then CalledProcedure;
  311.  End;
  312. End;
  313.  Procedure RemoveWindow;
  314.  Begin
  315.   Tmp := PushedWindow;
  316.   With W_Array[Tmp]^ Do Begin
  317.                          PopWindow;
  318.                          Displayed := False;
  319.                          If ShadowFlag Then PutToScreen(WinX-2,WinY,WinX1,WinY1+1,SavedScreen)
  320.                          Else PutToScreen(WinX,WinY,WinX1,WinY1,SavedScreen);
  321.  
  322.  
  323.                          {===== HERE MUST ENABLE PREVIOUS WINDOW =====}
  324.                         End;
  325.  End;
  326. Procedure TempMessage(X,Y,TxtF,TxtB : Byte;Txt : String);
  327. Var Ch : Char;
  328. Begin
  329. TempMessageChar(X,Y,TxtF,TxtB,Txt,Ch);
  330. End;
  331. Procedure TempMessageChar(X,Y,TxtF,TxtB : Byte;Txt : String;Var Ch : Char);
  332. Var Pt : Pointer;
  333.     A,B : Byte;
  334. Begin
  335.  If X = 0 Then X := 39 - (Length(Txt) div 2);
  336.  If Y = 0 Then Y := 12;
  337.  If MaxAvail < (Length(txt) shl 1) Then VTWinError (3);
  338.  GetMem(Pt,Length(txt) shl 1);
  339.  GetFromScreen(X,Y,x+Length(Txt),Y,pt);
  340.  ColorWrite(X,Y,TxtF,TxtB,Txt);
  341.  GetKey(a,b);
  342.  PutToScreen(X,Y,x+Length(Txt),Y,pt);
  343.  FreeMem(Pt,Length(txt) shl 1);
  344.  Ch := Chr(a);
  345. End;
  346.  
  347. Procedure TempMessageBox(X,Y,BoxF,BoxB,BoxT,TxtF,TxtB : Byte;Txt : String);
  348.   Var ch : Char;
  349. Begin
  350.  TempMessageBoxChar(X,Y,BoxF,BoxB,BoxT,TxtF,TxtB,Txt,Ch);
  351. End;
  352.  
  353. Procedure TempMessageBoxChar(X,Y,BoxF,BoxB,BoxT,TxtF,TxtB : Byte;Txt : String;Var Ch : Char);
  354. Var        Pts : Pointer;
  355.     BlockSizeC : Word;
  356.           A,B : Byte;
  357.           AVM : Word;
  358. Begin
  359.  If X < 2 Then X := 38 - (Length(Txt) div 2);
  360.  If Y < 2 Then Y := 12;
  361.  BlockSizeC := (Length(Txt) Shl 1) + 480;
  362.  AvM := MaxAvail;
  363.  If  AvM< BlockSizeC Then VTWinError(3);
  364.  GetMem(pts,BlockSizeC);
  365.  GetFromScreen(X-1,Y-1,X+Length(Txt)+1,Y+1,PtS);
  366.  ClearText(X-1,Y-1,X+Length(Txt)+1,Y+1,BoxF,BoxB);
  367.  DrawBox(X-1,Y-1,X+Length(Txt)+1,Y+1,Boxt);
  368.  ColorWrite(X,Y,TxtF,TxtB,Txt);
  369.  GetKey(A,B);
  370.  PutToScreen(X-1,Y-1,X+Length(Txt)+1,Y+1,PtS);
  371.  FreeMem(pts,BlockSizeC);
  372.  Ch := Chr(A);
  373. End;
  374. { *****    WORKING BUT NO USED NOW, BECOUSE IS LIKE TempMessageBox  **********
  375. Procedure ExplodeTempMessageBox(X,Y,BoxF,BoxB,BoxT,TxtF,TxtB : Byte;Txt : String);
  376. Var Ch : Char;
  377. Begin
  378.  ExplodeTempMessageBoxChar(X,Y,BoxF,BoxB,BoxT,TxtF,TxtB,Txt,Ch);
  379. End;
  380. Procedure ExplodeTempMessageBoxChar(X,Y,BoxF,BoxB,BoxT,TxtF,TxtB : Byte;
  381.                                      Txt : String;Var Ch : Char);
  382. Var Pt : Pointer;
  383.     BlockSize : Word;
  384. Begin
  385.  If X < 2 Then X := 38 - (Length(Txt) div 2);
  386.  If Y < 2 Then Y := 12;
  387.  BlockSize := (Length(Txt) Shl 1) + 480;
  388.  If MaxAvail < BlockSize Then VTWinError(3);
  389.  GetMem(pt,BlockSize);
  390.  GetFromScreen(X-1,Y-1,X+Length(Txt)+1,Y+1,Pt);
  391.  ExplodeBox(X-1,Y-1,X+Length(Txt)+1,Y+1,BoxF,BoxB,BoxT);
  392.  ColorWrite(X,Y,TxtF,TxtB,Txt);
  393.  GetKey(Key,Key1);
  394.  PutToScreen(X-1,Y-1,X+Length(Txt)+1,Y+1,Pt);
  395.  FreeMem(pt,BlockSize);
  396.  Ch := Chr(Key);
  397. End;          ------------}
  398. Procedure WinInit;
  399. Begin
  400.  StartMemorySize := MaxAvail;
  401.  For Tmp := 1 To MaxScreens Do Begin
  402.                                  GetMem(S_Array[Tmp],SizeOf(ScreenDescription));
  403.                                  S_Array[Tmp]^.Saved := False;
  404.                                  S_Array[Tmp]^.Allocated := False;
  405.                                End;
  406.  For Tmp := 1 To MaxWindows do Begin
  407.                                GetMem(W_Array[Tmp],SizeOf(WindowDescription));
  408.                                With W_Array[Tmp]^ Do Begin
  409.                                                        Displayed := False;
  410.                                                        Attached := False;
  411.                                                        CalledProcedure := Nil;
  412.                                                        Title := '';
  413.                                                      End;
  414.                                 End;
  415.  attachedWindows :=[];
  416.  If Not SavedMemoryFlag Then Begin
  417.                               Mark(StartMemoPoint);
  418.                               Release(StartMemoPoint);
  419.                               Mark(StartMemoPoint);
  420.                              End;
  421.  
  422. End;
  423. BEGIN
  424. WinInit;
  425. END.